Proyecto No.1
Héctor Valle, Rodrigo Samayoa & Paul Belches
23/3/2020
library(stringr)
#setwd("~/Documents/Mineria/Proyecto-Mineria/")
datosIne<-read.csv("mortalidadIne2.csv", header=FALSE, stringsAsFactors=FALSE, fileEncoding="latin1")
#names(datosIne)[1] <- "hola"
names(datosIne)[1] <- "depocu"
names(datosIne)[2] <- "mupocu"
names(datosIne)[3] <- "sexo"
names(datosIne)[4] <- "diaocu"
names(datosIne)[5] <- "anoreg"
names(datosIne)[6] <- "mesocu"
names(datosIne)[7] <- "edadif"
names(datosIne)[8] <- "ecidif"
names(datosIne)[9] <- "escodif"
names(datosIne)[10] <- "dredif"
names(datosIne)[11] <- "mredif"
names(datosIne)[12] <- "caudef"
#Only letter
datosIne <- datosIne[-1,]
datosIne$caudef <- substr(datosIne$caudef, 1, 1)
datosIne<-filter(datosIne, caudef == "V")
#Eliminate special characters
datosIne$depocu <- str_replace_all(datosIne$depocu, "[^[:alnum:]]", "")
datosIne$mupocu <- str_replace_all(datosIne$mupocu, "[^[:alnum:]]", "")
datosIne$mesocu <- str_replace_all(datosIne$mesocu, "[^[:alnum:]]", "")
datosIne$escodif <- str_replace_all(datosIne$escodif, "[^[:alnum:]]", "")
datosIne$dredif <- str_replace_all(datosIne$dredif, "[^[:alnum:]]", "")
datosIne$mredif <- str_replace_all(datosIne$mredif, "[^[:alnum:]]", "")
#datosIne$caudef > "V00"
#Eliminate (a)
datosIne$ecidif <- str_replace_all(datosIne$ecidif, "\\(a\\)", "")Descripción de la situación problemática:
Los accidentes de tránsito son la segunda causa de muerte en Guatemala, por detrás de los incidentes que involucran armas de fuego. Diariamente alrededor de 17 accidentes de tránsito deja varios fallecidos según el Instituto Nacional de Ciencias Forenses. A pesar de que los incidentes han disminuido en cantidad durante el plazo 2018 - 2019, la magnitud de los accidentes y la cantidad de muertes solo ha aumentado. En comparación, el año 2019 ha excedido a su predecesor por más de 113 muertes. Las causas varían relacionando a todo tipo de vehiculos, buses de transporte extraurbano, transporte de carga y automóviles livianos. Por lo que se busca determinar el impacto de las crecientes importaciones de vehículos, en este fenómeno.
Objetivos preliminares.
Identificar las condiciones en que estos accidentes de tránsito letales ocurren en mayor consistencia.
Identificar los perfiles de las personas involucradas en los accidentes de tránsito letales.
Identificar las regiones con mayor incidencia de accidentes de tráfico letales.
Determinar si la región con mayor indice de importación coincide con la región de mayor incidencia de accidentes de tránsito letal.
Información a utilizar
Para responder la problemática que se presenta, se utilizaran:
- Base de datos de la importaciones de la SAT
- Base de datos de defunciones del Ine
Descripción de Variables:
SAT
La base de datos de defunciones de la SAT, busca almacenar toda la información pertinente en relación a la importación de vehículos al territorio nacional; registrando la mayor cantidad de datos en relación. A continuación se presenta una lista de las variables presentes dentro de este set de datos, además de el valor que representan.
País de Proveniencia (Cualitativa Nominal): País del que proviene el vehículo
Aduana de ingreso (Cualitativa Nominal): Nombre de la aduana en la que el vehículo ingreso
Fecha de la Póliza (Cualitativa Ordinal): Fecha en la que el carro es registrado
Partida Arancelaria (Cuantitativa Discreta): Código de distinción para saber al grupo de pago de impuestos al que pertenece
Modelo del Vehículo (Cualitativa Ordinal): Modelo del vehículo
Marca (Cualitativa Nominal): Marca del vehículo
Línea (Cualitativa Nominal): Linea del vehiculo
Centímetros Cúbicos (Cuantitativa Discreta): Tamaño del motor
Distintivo (Cualitativa Nominal): Distintivo del vehículo
Tipo de Vehículo (Cualitativa Nominal): Tipo de vehículo
Tipo de Importador (Cualitativa Nominal): Tipo de importador (OCASIONAL o DISTRIBUIDOR)
Tipo Combustible (Cualitativa Nominal): Combustible que utiliza el vehículo
Asientos (Cuantitativa Discreta): Número de asientos que tiene el vehiculo
Puertas (Cuantitativa Discreta): Número de puertas que tiene el vehículo
Tonelaje (Cuantitativa Discreta): Peso del vehículo
Valor VIF (Cuantitativa Continua): Costo del vehículo después de haber pagado impuestos
Impuesto (Cuantitativa Continua): Cantidad de impuestos que se debe pagar
En el caso de la SAT, las variables que se utilizarán son País de Proveniencia, Modelo del Vehículo, Marca, Línea, Centímetros Cúbicos, Distintivo, Tipo de Vehículo, Tipo de Combustible, Asientos, Puertas, Tonelaje y Valor CIF. Estas variables se eligieron debido a que luego de identificar las características de los vehículos involucrados en accidentes fatales, se evaluarían sus características en el ámbito de importaciones.
Para el dataset de importaciones de la SAT los procesos de limpieza que se realizaron fueron los siguientes: Se eliminaron todas las filas en las cuales existieran valores nulos para algunos de las columnas. Luego se buscó estandarizar los datos categóricos, asegurando que no existieron caracteres especiales en los diferentes valores. Los valores que se buscaron fueron tildes y signos de puntuación, pero estos no se encontraron ya que todas las variables con caracteres estaban en mayúsculas y sin tildes.
INE
La base de datos de defunciones del INE, busca almacenar toda la información pertinente en relación al deceso de una persona dentro del territorio nacional; registrando la mayor cantidad de datos en relación al suceso. A continuación se presenta una lista de las variables presentes dentro de este set de datos, además de el valor que representan.
Depocu (Cualitativa Nominal): Departamento de registro
Mupocu (Cualitativa Nominal): Municipio de registro
Mesreg (Cualitativa Nominal): Mes de registro
Añoreg (Cualitativa Ordinal): Año de registro
Depocu (Cualitativa Ordinal): Departamento de ocurrencia
Mupocu (Cualitativa Nominal): Municipio de ocurrencia
Sexo (Cualitativa Nominal): Mes de ocurrencia
Añoocu (Cualitativa Ordinal): Año de ocurrencia
Edadif (Cualitativa Ordinal): Edad del difunto
Perdif (Cualitativa Ordinal): Periodo de edad del difunto
Puedif (Cualitativa Ordinal): Pueblo al que pretenece el difunto
Ecidif (Cualitativa Nominal): Estado civil del difunto
Escodif (Cualitativa Nominal): Ecolaridad del difunto
Ciuodif (Cualitativa Nominal): Ocupación del difunto
Pnadif (Cualitativa Nominal): País de nacieminto del equipo
Dnadif (Cualitativa Nominal): Departamento de nacimiento del difunto
Mnadif (Cualitativa Nominal): Municipio del nacimiento del difunto
Nacdif (Cualitativa Nominal): Nacionalidad del difunto
Predif (Cualitativa Nominal): País de recidencia del difunto
Dredif (Cualitativa Nominal): Departamento de recidencia del difunto
Mredif (Cualitativa Nominal): Municipio de recidencia del difunto
Caudef (Cualitativa Nominal): Causa de defunción
Asist (Cualitativa Nominal): Asistencia recibida
Oucr (Cualitativa Nominal): Sitio de ocurrencia
Cerdef (Cualitativa Nominal): Quien certifica
En el caso de Ine, las variables a utilizar serán, depocu, mupocu, sexo, diaocu, añoreg, mesocu, edadif, ecidif, escodif, dredif, mredif, caudef. Esto en primer lugar, gracias a que son variables que se encuentran presentes en todos los datasets año tras año, del 2011 al 2018. Además en variables como la ocupación del difunto el valor indefinido se encuentra repetidas veces por lo que no permite la extracción de información de manera adecuada.
Para el dataset de defunciones del INE los procesos de limpieza que se realizaron fueron los siguientes: Se eliminaron todas las filas en las cuales existieran valores nulos para algunos de las columnas. Luego se buscó estandarizar los datos categóricos, asegurando que no existieron caracteres especiales en los diferentes valores. Los valores que se buscaron fueron tildes y signos de puntuación, que por facilidad se eliminaron en su mayoría desde excel. Además se estandarizó el valor del estado civil, por la existencia de categorías con género y sin género. Por último se seleccionó únicamente los decesos relacionados con incidentes vehiculares.
Tablas de frecuencia de variables elegidas
SAT
Pais de Proveniencia
#Pais de Proveniencia
df <- datos %>%
group_by(Pais.de.Proveniencia) %>%
summarise(count = n())
df <- df[order(-df$count),]
df[1:10,]## # A tibble: 10 x 2
## Pais.de.Proveniencia count
## <chr> <int>
## 1 CHINA 666345
## 2 JAPON 324422
## 3 ESTADOS UNIDOS 305488
## 4 INDIA 220345
## 5 COREA DEL SUR 71551
## 6 CANADA 43330
## 7 TAILANDIA 33405
## 8 MEXICO 30150
## 9 ALEMANIA REP. FED. 19166
## 10 BRASIL 14587ggplot(df[1:10,], aes(x = reorder(Pais.de.Proveniencia,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.3) + theme_pubclean()
Como se puede observar en la gráfica, solo se presentan 10 países, esto se debe a que la cantidad de países dentro de los datos es muy grande para poder graficarlos de tal manera que se pueda identificar los países claramente, por lo cual se eligieron los 10 países con la mayor cantidad de instancias. Se pueden observar los países con la cantidad más grande de instancias de importaciones son China, Japón y Estado Unidos.
Modelo de Vehículo
#Modelo de Vehiculo
df <- datos %>%
group_by(Modelo.del.Vehiculo) %>%
summarise(count = n())
df## # A tibble: 102 x 2
## Modelo.del.Vehiculo count
## <int> <int>
## 1 1900 363
## 2 1910 1
## 3 1911 1
## 4 1918 1
## 5 1921 1
## 6 1922 1
## 7 1923 2
## 8 1924 1
## 9 1925 4
## 10 1926 4
## # … with 92 more rowsggplot(df, aes(x = Modelo.del.Vehiculo, y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = ""), vjust = -0.5) + theme_pubclean()
hist(datos$Modelo.del.Vehiculo)
Esta gráfica presenta la distribución de el año de modelo de los vehículos, y como se puede observar, la tasa de crecimiento a lo largo de los años ha sido exponencial, de tal manera que la cantidad de importaciones año tras año ha ido incrementando, con últimos 3 años como los que tienen la mayor cantidad.
Marca
#Marca
df <- datos %>%
group_by(Marca) %>%
summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Marca,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
En esta gráfica se presenta la distribución de la cantidad de vehículos por marca, tomando en cuenta las 10 marcas con mayor cantidad de filas, donde curiosamente las 3 marcas con la mayor cantidad de instancias son japonesas, y como se pudo ver en el país de proveniencia, también es uno de los países que más apareció.
Linea
#Linea
df <- datos %>%
group_by(Linea) %>%
summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Linea,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
Como se puede observar en la gráfica, se presentan las 10 líneas de vehículo con la mayor cantidad de filas que las contienen, y como se puede observar, la que tiene la mayor cantidad es una motocicleta marca Suzuki, la cual aparece casi el doble del segundo lugar.
Centímetros Cúbicos
#Centímetros.Cúbicos
df <- datos %>%
group_by(Centimetros.Cubicos) %>%
summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Centimetros.Cubicos,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
Esta gráfica presenta el tamaño del motor del vehículo en centímetros cúbicos, y debido a la gran cantidad de datos, se presentan los 10 tamaños más comunes en el dataset, con el tamaño más común siendo de 125 centímetros cúbicos.
Distintivo
#Distintivo
df <- datos %>%
group_by(Distintivo) %>%
summarise(count = n())
df <- df[order(-df$count),]
df## # A tibble: 3 x 2
## Distintivo count
## <chr> <int>
## 1 "LIVIANO" 1648624
## 2 "PESADO" 102504
## 3 "" 16291ggplot(df, aes(x = reorder(Distintivo,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
En esta gráfica se puede observar el distintivo del vehículo, en la cual las 3 posibles categorías son Liviano, Pesado y ninguno de los 2. Claramente la mayor cantidad de vehículos son clasificados como livianos.
Tipo de Vehículo
#Tipo de Vehículo
df <- datos %>%
group_by(Tipo.de.Vehiculo) %>%
summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Tipo.de.Vehiculo,count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
Como se puede observar en la gráfica, aquí se presenta el tipo de vehículo que se está importando, donde el tipo que más se importa son las motocicletas, siendo casi el triple de la cantidad de automóviles importados. Esto se puede razonar a ser debido a que los precios de moto suelen ser mucho menores a la de los carros, por lo cual es una alternativa que suele elegirse debido a la situación económica de la población.
Tipo de Combustible
#Tipo de Combustible
df <- datos %>%
group_by(Tipo.Combustible) %>%
summarise(count = n())
df <- df[order(-df$count),]
ggplot(df, aes(x = reorder(Tipo.Combustible, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
Esta gráfica muestra el tipo de combustible de los vehículos importados, donde estos pueden utilizar gasolina, Diesel u otros, y se puede ver que los vehículos son principalmente de gasolina.
Asientos
#Asientos
df <- datos %>%
group_by(Asientos) %>%
summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Asientos, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
En esta gráfica se puede observar la cantidad de asientos que tiene el vehículo, en las cuales la más común es 2, lo cual podría asumir que es una motocicleta como se vio en las gráficas anteriores, y el siguiente que es de 5, se puede suponer que es un automóvil.
Puertas
#Puertas
df <- datos %>%
group_by(Puertas) %>%
summarise(count = n())
df <- df[order(-df$count),]
ggplot(df, aes(x = reorder(Puertas, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
Como se puede apreciar en esta gráfica se puede observar la cantidad de puertas que tiene el vehículo, en las cuales la más común es 0, lo cual podría asumir que es una motocicleta como se vio en las gráficas anteriores, y el siguiente que es de 4 y 2, se puede suponer que es un automóvil.
Tonelaje
#Tonelaje
df <- datos %>%
group_by(Tonelaje) %>%
summarise(count = n())
df <- df[order(-df$count),]
ggplot(df[1:10,], aes(x = reorder(Tonelaje, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
En gráfica muestra el tonelaje del vehículo, en las cuales la más común es 0, lo cual podría asumir que es un vehículo que no necesariamente pese 0 toneladas, sino que menos de 1 tonelada, y el siguiente que es de 1, se puede suponer que es un vehículo más pesado pero del mismo tipo.
Valor CIF
#Valor.CIF
df <- datos %>%
group_by(Valor.CIF) %>%
summarise(count = n())
df <- df[order(-df$count),]
hist(df$Valor.CIF)
En esta gráfica se puede observar el Valor CIF de cada vehículo, el cual es el valor real de las mercancías durante el despacho aduanero, en el cual se incluye el costo de las mercancías, el seguro y del flete hasta el puerto de destino.
Año
df <- datos %>%
group_by(Anio) %>%
summarise(count = n())
df <- df[order(-df$count),]
ggplot(df, aes(x = reorder(Anio, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
#### Ine
Departamento
#Departamento
df <- datosIne %>%
group_by(depocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## depocu count n
## <chr> <int> <dbl>
## 1 Escuintla 1418 1
## 2 Guatemala 1220 2
## 3 Quetzaltenango 812 3
## 4 Peten 702 4
## 5 SantaRosa 692 5
## 6 Izabal 672 6
## 7 Huehuetenango 564 7
## 8 Jutiapa 514 8
## 9 Zacapa 382 9
## 10 Chimaltenango 373 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La tabla de frecuencia muestra la cantidad de decesos registrados por departamento ordenados de forma descendente, para los 10 departamentos con mayor cantidad de decesos. Como se puede observar Escuintla cuenta con el mayor número de decesos, seguido por Guatemala. Como se puede ver en los histogramas , la diferencia entre los primeros dos departamentos y los demás es evidente. Para la cantia posición la cantidad de decesos se redujo a la mitad.
Municipio
#Municipio
df <- datosIne %>%
group_by(mupocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:20,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 20 x 3
## mupocu count n
## <chr> <int> <dbl>
## 1 Guatemala 829 1
## 2 Escuintla 717 2
## 3 Cuilapa 404 3
## 4 Quetzaltenango 321 4
## 5 PuertoBarrios 303 5
## 6 Coatepeque 300 6
## 7 Zacapa 221 7
## 8 SanBenito 212 8
## 9 Jutiapa 205 9
## 10 Morales 191 10
## 11 Mixco 189 11
## 12 Retalhuleu 188 12
## 13 Huehuetenango 186 13
## 14 Tiquisate 174 14
## 15 Chimaltenango 156 15
## 16 Chiquimula 155 16
## 17 Poptiºn 133 17
## 18 SantaCruzdelQuiche 129 18
## 19 Coban 109 19
## 20 Guastatoya 91 20ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por municipio ordenados de forma descendente, para los 10 municipios con mayor cantidad de decesos. Como se puede observar Guatemala cuenta con el mayor número de decesos, seguido por Escuintla. En relación a la gráfica anterior , resalta cómo es que la posición de los departamentos representados cambia en orden. De una misma manera es evidente el descenso exponencial que existe, al moverse de los primeros municipios , a las posiciones medias de la tabla.
Sexo
#Sexo
df <- datosIne %>%
group_by(sexo) %>%
summarise(count = n())
df <- df[order(-df$count),]
print(df)## # A tibble: 2 x 2
## sexo count
## <chr> <int>
## 1 Hombre 8557
## 2 Mujer 1814ggplot(df, aes(x = reorder(sexo, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La tabla de frecuencia muestra la cantidad de decesos registrados por sexo. Como se puede ver en los histogramas , la diferencia entre la cantidad de hombres y mujeres es considerable en consideración. La cantidad de hombres es casi 4 veces más que las mujeres.
Día de ocurrencia
#Día de ocurrencia
df <- datosIne %>%
group_by(diaocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
print(df)## # A tibble: 10 x 2
## diaocu count
## <chr> <int>
## 1 1 426
## 2 15 391
## 3 25 385
## 4 2 379
## 5 21 364
## 6 3 363
## 7 17 361
## 8 9 361
## 9 22 360
## 10 4 355ggplot(df, aes(x = reorder(diaocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por día del mes de forma descendente, para los 10 días con mayor cantidad de decesos. Como se puede observar la quincena y el principio de mes, son los días que se presenta una mayor cantidad de decesos. Probablemente relacionado con que ambos días son días de pago. Sin embargo la cantidad no desciende mucho en relación a los demás días como se puede ver en el histograma.
Año de registro
#Año de registro
df <- datosIne %>%
group_by(anoreg) %>%
summarise(count = n())
df <- df[order(-df$count),]
print(df)## # A tibble: 9 x 2
## anoreg count
## <chr> <int>
## 1 2018 3161
## 2 2017 1478
## 3 2014 1249
## 4 2015 1227
## 5 2013 1171
## 6 2012 977
## 7 2011 944
## 8 2019 136
## 9 2016 28ggplot(df, aes(x = reorder(anoreg, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por año de forma descendiente, para el periodo 2016-2019. Como se puede observar en los histogramas, existe un crecimiento exponencial del año 2017 al 2018. Por lo que se supone que en 2018 existió un mejor registro, en relación a los demás años. Además los años 2016 y 2019, cuentan con valores extremadamente bajos, lo que se puede deber a un mal registro.
Mes de ocurrencia
#Mes de ocurrencia
df <- datosIne %>%
group_by(mesocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:9,]
print(df)## # A tibble: 9 x 2
## mesocu count
## <chr> <int>
## 1 Diciembre 1142
## 2 Marzo 951
## 3 Septiembre 892
## 4 Enero 871
## 5 Noviembre 871
## 6 Abril 841
## 7 Junio 834
## 8 Julio 827
## 9 Febrero 814ggplot(df, aes(x = reorder(mesocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por mes de forma descendente, para los 9 meses con mayor cantidad de decesos registrados. Como se puede observar diciembre es el mes que cuenta con una mayor cantidad de muertes. Probablemente relacionado con la coincidencia con el periodo de vacaciones. Sin embargo la cantidad no varía mucho entre los meses restantes.
Edad de difuntos
#Edad de difuntos
df <- datosIne %>%
group_by(edadif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
print(df)## # A tibble: 10 x 2
## edadif count
## <chr> <int>
## 1 21 336
## 2 22 323
## 3 24 320
## 4 20 316
## 5 23 315
## 6 25 303
## 7 26 299
## 8 19 287
## 9 28 275
## 10 27 273ggplot(df, aes(x = reorder(edadif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La siguiente tabla de frecuencia muestra la cantidad de decesos registrados por edad. Como se puede observar el rango se maneja de 19 a 28 años. Sin existir una gran diferencia. Sin embargo, tomando en cuenta que la mayoría de los primeros valores, pertenecen a la primera mitad del rango. Podríamos afirmar que a medida que la edad aumentan los decesos relacionados con incidentes vehiculares desciende.
Estado civil
#Estado civil
df <- datosIne %>%
group_by(ecidif) %>%
summarise(count = n())
df <- df[order(-df$count),]
print(df)## # A tibble: 4 x 2
## ecidif count
## <chr> <int>
## 1 Soltero 7062
## 2 Casado 3126
## 3 Ignorado 96
## 4 Unido 87ggplot(df, aes(x = reorder(ecidif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La siguiente tabla de frecuencia muestra la cantidad de decesos registrados agrupados por el estado civil del difunto. Como se puede observar es evidente que los solteros , son la gran mayoría. Tomando en cuenta la tabla anterior, que la mayoría de decesos esté relacionada con gente jóven, puede dar razón al por qué de esta distribución. Sin embargo también puede estar relacionado a la tasa de matrimonios del país, aunque esto no forma parte del enfoque del estudio.
Escolaridad del difunto
#Escolaridad del difunto
df <- datosIne %>%
group_by(escodif) %>%
summarise(count = n())
df <- df[order(-df$count),]
print(df)## # A tibble: 7 x 2
## escodif count
## <chr> <int>
## 1 Primaria 3262
## 2 Ninguna 2857
## 3 Diversificado 1670
## 4 Basico 1363
## 5 Ignorado 1027
## 6 Universitario 191
## 7 Postgrado 1ggplot(df, aes(x = reorder(escodif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La siguiente tabla de frecuencia muestra la cantidad de decesos registrados agrupados por la escolaridad del difunto. Los grupos con menor educación cuentan con las primeras posiciones de la tabla. A pesar de que el grupo Primaria sobrepasa al no que no estudio, esto puede estar relacionado con el mayor acceso que se puede llegar a tener a vehículos. Además manteniendo la misma línea de pensamiento, se puede observar cómo es que tanto los grados universitarios como Postgrado, representan el fondo de la tabla.
Departamento de residencia del difunto
#Departamento de residencia del difunto
df <- datosIne %>%
group_by(dredif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## dredif count n
## <chr> <int> <dbl>
## 1 Guatemala 1256 1
## 2 Escuintla 947 2
## 3 Izabal 650 3
## 4 Peten 640 4
## 5 Ignorado 577 5
## 6 Quetzaltenango 571 6
## 7 SantaRosa 556 7
## 8 Huehuetenango 549 8
## 9 Jutiapa 533 9
## 10 SanMarcos 489 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La tabla de frecuencia muestra la cantidad de decesos registrados por departamento de residencia ordenados de forma descendente, para los 10 departamentos de recidencia con mayor cantidad de decesos. Como se puede observar Guatemala cuenta con el mayor número de decesos, seguido por Escuintla, concordando con las tablas del inicio. Sin embargo la diferencia es considerable en comparación.
Municipio de residencia del difunto
#Municipio de residencia del difunto
df <- datosIne %>%
group_by(mredif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## mredif count n
## <chr> <int> <dbl>
## 1 Ignorado 577 1
## 2 Guatemala 539 2
## 3 Escuintla 224 3
## 4 PuertoBarrios 212 4
## 5 Morales 210 5
## 6 VillaNueva 159 6
## 7 Mixco 154 7
## 8 Quetzaltenango 152 8
## 9 Jutiapa 142 9
## 10 NuevaConcepciin 132 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
La tabla de frecuencia muestra la cantidad de decesos registrados por departamento de residencia ordenados de forma descendente, para los 10 departamentos de recidencia con mayor cantidad de decesos. Como se puede observar Guatemala cuenta con el mayor número de decesos, seguido por Escuintla, concordando con las tablas del inicio. Sin embargo la diferencia es considerable en comparación.
Clusters SAT
Para poder llevar a cabo un mejor análisis de las variables categóricas del dataset de importaciones de la SAT, se le asignaron valores numéricos a cada instancia única de las variables, para así poder utilizar varias herramientas de análisis como histogramas, mapas de calor, matrices de correlación y otras.
#Convert categorical dataset into numerical categorical
datosSAT<-datos
datosSAT$Pais.de.Proveniencia <- as.numeric(factor(datosSAT$Pais.de.Proveniencia))
datosSAT$Modelo.del.Vehiculo <- as.numeric(factor(datosSAT$Modelo.del.Vehiculo))
datosSAT$Marca <- as.numeric(factor(datosSAT$Marca))
datosSAT$Linea <- as.numeric(factor(datosSAT$Linea))
datosSAT$Distintivo <- as.numeric(factor(datosSAT$Distintivo))
datosSAT$Tipo.de.Vehiculo <- as.numeric(factor(datosSAT$Tipo.de.Vehiculo))
datosSAT$Tipo.Combustible <- as.numeric(factor(datosSAT$Tipo.Combustible))library(factoextra)## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(cluster)
library(corrplot)## corrplot 0.84 loadedlibrary(fpc)
corel <- cor(datosSAT)
corel## Pais.de.Proveniencia Modelo.del.Vehiculo Marca
## Pais.de.Proveniencia 1.00000000 -0.24393505 0.094645890
## Modelo.del.Vehiculo -0.24393505 1.00000000 -0.226775905
## Marca 0.09464589 -0.22677590 1.000000000
## Linea 0.06201196 0.02515564 0.139939447
## Centimetros.Cubicos 0.23295591 -0.48945617 0.022308648
## Distintivo 0.02756578 -0.19683647 -0.079659036
## Tipo.de.Vehiculo -0.18284903 0.25273030 0.012696507
## Tipo.Combustible -0.18118815 0.03242130 0.051678655
## Asientos 0.10573900 -0.19358230 -0.003785744
## Puertas 0.38552552 -0.43346962 0.116152874
## Tonelaje 0.01996583 -0.14194095 -0.026982811
## Valor.CIF -0.13043222 0.35608349 -0.242167156
## Anio 0.08105821 0.22031249 -0.019055770
## Mes -0.02523044 0.00565269 -0.010435640
## Dia -0.01328994 -0.02716511 0.019137652
## DiaSem 0.01274759 -0.08381882 0.016200440
## Linea Centimetros.Cubicos Distintivo
## Pais.de.Proveniencia 0.062011959 0.23295591 0.027565782
## Modelo.del.Vehiculo 0.025155635 -0.48945617 -0.196836468
## Marca 0.139939447 0.02230865 -0.079659036
## Linea 1.000000000 -0.05997611 -0.051363140
## Centimetros.Cubicos -0.059976110 1.00000000 0.556389159
## Distintivo -0.051363140 0.55638916 1.000000000
## Tipo.de.Vehiculo 0.056075983 -0.47107835 -0.186604021
## Tipo.Combustible 0.048647785 -0.58682580 -0.515317313
## Asientos -0.058355249 0.33930343 0.278655719
## Puertas -0.007781753 0.52143580 0.074055662
## Tonelaje -0.003975428 0.26856365 0.337934617
## Valor.CIF 0.127736347 -0.25362049 -0.044872125
## Anio 0.038140595 -0.02895566 -0.034637998
## Mes -0.024666122 -0.01277855 -0.002211687
## Dia -0.005810250 0.02006581 -0.003888485
## DiaSem -0.020058446 0.06240000 0.015231988
## Tipo.de.Vehiculo Tipo.Combustible Asientos
## Pais.de.Proveniencia -0.182849031 -0.181188152 0.105739000
## Modelo.del.Vehiculo 0.252730297 0.032421303 -0.193582295
## Marca 0.012696507 0.051678655 -0.003785744
## Linea 0.056075983 0.048647785 -0.058355249
## Centimetros.Cubicos -0.471078353 -0.586825803 0.339303433
## Distintivo -0.186604021 -0.515317313 0.278655719
## Tipo.de.Vehiculo 1.000000000 0.143207902 -0.331320030
## Tipo.Combustible 0.143207902 1.000000000 -0.310227567
## Asientos -0.331320030 -0.310227567 1.000000000
## Puertas -0.755618373 -0.186299185 0.341314023
## Tonelaje -0.051261927 -0.116938500 0.012548229
## Valor.CIF 0.304409377 0.009644520 -0.109583642
## Anio -0.009056993 0.045764690 -0.001907132
## Mes 0.029341906 0.006121456 -0.011562311
## Dia -0.019637979 0.012247284 0.001547174
## DiaSem -0.080476105 -0.002683385 0.032608459
## Puertas Tonelaje Valor.CIF Anio
## Pais.de.Proveniencia 0.385525522 0.019965826 -0.130432216 0.081058214
## Modelo.del.Vehiculo -0.433469623 -0.141940946 0.356083492 0.220312491
## Marca 0.116152874 -0.026982811 -0.242167156 -0.019055770
## Linea -0.007781753 -0.003975428 0.127736347 0.038140595
## Centimetros.Cubicos 0.521435803 0.268563653 -0.253620495 -0.028955661
## Distintivo 0.074055662 0.337934617 -0.044872125 -0.034637998
## Tipo.de.Vehiculo -0.755618373 -0.051261927 0.304409377 -0.009056993
## Tipo.Combustible -0.186299185 -0.116938500 0.009644520 0.045764690
## Asientos 0.341314023 0.012548229 -0.109583642 -0.001907132
## Puertas 1.000000000 0.003770570 -0.356398367 -0.010947744
## Tonelaje 0.003770570 1.000000000 -0.027094985 -0.021258464
## Valor.CIF -0.356398367 -0.027094985 1.000000000 0.002640729
## Anio -0.010947744 -0.021258464 0.002640729 1.000000000
## Mes -0.034108024 0.003293937 0.005790687 -0.147249916
## Dia 0.014453379 0.008388885 -0.015455646 -0.019179948
## DiaSem 0.091917785 0.007425894 -0.073728941 -0.048655372
## Mes Dia DiaSem
## Pais.de.Proveniencia -0.025230441 -1.328994e-02 1.274759e-02
## Modelo.del.Vehiculo 0.005652690 -2.716511e-02 -8.381882e-02
## Marca -0.010435640 1.913765e-02 1.620044e-02
## Linea -0.024666122 -5.810250e-03 -2.005845e-02
## Centimetros.Cubicos -0.012778550 2.006581e-02 6.240000e-02
## Distintivo -0.002211687 -3.888485e-03 1.523199e-02
## Tipo.de.Vehiculo 0.029341906 -1.963798e-02 -8.047610e-02
## Tipo.Combustible 0.006121456 1.224728e-02 -2.683385e-03
## Asientos -0.011562311 1.547174e-03 3.260846e-02
## Puertas -0.034108024 1.445338e-02 9.191779e-02
## Tonelaje 0.003293937 8.388885e-03 7.425894e-03
## Valor.CIF 0.005790687 -1.545565e-02 -7.372894e-02
## Anio -0.147249916 -1.917995e-02 -4.865537e-02
## Mes 1.000000000 -5.513890e-03 1.526503e-02
## Dia -0.005513890 1.000000e+00 4.976659e-06
## DiaSem 0.015265033 4.976659e-06 1.000000e+00corrplot(corel)
wcss <- vector()
for(i in 1:10){
wcss[i] <- sum(kmeans(datosSAT, i)$withinss)
}
ggplot() + geom_point(aes(x = 1:10, y = wcss), color = 'blue') +
geom_line(aes(x = 1:10, y = wcss), color = 'blue') +
ggtitle("Método del Codo") +
xlab('Cantidad de Centroides k') +
ylab('WCSS')
Debido a que la cantidad de datos que se encuentra en el dataset de importaciones de la SAT es más de 2 millones de filas con 16 columnas, varios de los métodos de análisis que se implementaron no podían soportar un manejo de datos tan grande por lo cual se tuvo que crear samples del dataset del tamaño más grande que fuera posible para el método. Específicamente para la prueba de la silueta, no se pudo evaluar sobre todos los datos, pero como se puede observar sobre el sample que se obtuvo, el resultado fue consistentemente alrededor de 0.80 por lo cual la clasificación por clustering elegida con K-means fue aceptable definiendo 2 centroides de acuerdo a la gráfica de codo.
k <- kmeans(datosSAT, centers = 2)
p <- fviz_cluster(k, geom = "point", data = datosSAT)+ ggtitle("k = 2")
p
datosSAT$kgroup <- k$cluster
plotcluster(datosSAT[,-c(17)],k$cluster)
sam<-sample(1:nrow(datosSAT),20000)
silkm<-silhouette(datosSAT[sam,"kgroup"],dist(datosSAT[sam,1:16]))
mean(silkm[,3])## [1] 0.7966865library(e1071)#para cmeans
library(cluster) #Para calcular la silueta
datosSample <- sample(1:nrow(datosSAT), 10000)
#cmeans
fcm<-cmeans(datosSAT,2)
datosSAT$FCGrupos<-fcm$cluster
#silueta
silfcm<-silhouette(datosSAT[datosSample,"FCGrupos"],dist(datosSAT[datosSample,1:16]))
mean(silfcm[,3])## [1] 0.800561###Histogramas de variables SAT por grupo
Modelo del vehiculo
#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Modelo.del.Vehiculo"])
#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Modelo.del.Vehiculo"])
Los histogramas anteriores nos muestran como se ve la variable “modelo del vehiculo” en ambos grupos del cluster. En el grupo 1 hay muy pocos carros que sean modelo antes de 2010 y no hay ninguno que sea antes del 2000, mientras que en el grupo 2 hay un poqueño pocentaje de carros que son modelo antes del 2000, los demas estan entre 2000 y 2020.
Marca
#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Marca"])
#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Marca"])
Los histogramas anteriores nos muestran como se ve la variable “Marca” en ambos grupos del cluster. En el grupo 1 se puede observar que hay 2 marcas que sobresalen, las cuales son Toyota seguido de Honda. Mientras que en el grupo 2 las 2 que sobre salen es Honda, al igual que en el grupo 1, seguida de Suzuki.
Linea
#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Linea"])
#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Linea"])
Los histogramas anteriores nos muestran como se ve la variable “Linea” en ambos grupos del cluster. En el grupo uno la linea que mas se repite es GN125F, mientras que en el grupo 2 la que mas se repite es CGL125.
Centimetros Cubicos
#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Centimetros.Cubicos"])
#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Centimetros.Cubicos"])
Los histogramas anteriores nos muestran como se ve la variable “Centimetros cubicos” en ambos grupos del cluster. Como se puede observar la distribucion de ambos grupos esta igual.
Tipo de vehiculo
#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Tipo.de.Vehiculo"])
#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Tipo.de.Vehiculo"])
Los histogramas anteriores nos muestran como se ve la variable “tipo de vehiculo” en ambos grupos del cluster. Como se puede ver en ambos grupos el tipo de vehiculo que mas se repite es el mismo, siento este las motocicletas.
Asientos
#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Asientos"])
#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Asientos"])
Los histogramas anteriores nos muestran como se ve la variable “Asientos” en ambos grupos del cluster. Como se puede observar la distribucion de ambos grupos esta igual.
Puertas
#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Puertas"])
#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Puertas"])
Los histogramas anteriores nos muestran como se ve la variable “Puertas” en ambos grupos del cluster. Como se puede observar la cantidad de puertas que mas se repite es 0, esto se debe a que el tipo de vehiculo que mas se repite en ambos grupos son las motocicletass.
Valor CIF
#grupo 1
hist(datosSAT[datosSAT$kgroup==1, "Valor.CIF"])
#grupo 2
hist(datosSAT[datosSAT$kgroup==2, "Valor.CIF"])
Los histogramas anteriores nos muestran como se ve la variable “Valor CIF” en ambos grupos del cluster. Como se puede observar el valor que mas se repite en ambos grupos es el 0.
Clusters INE
Con el objetivo de la realización de los clústeres, se convirtieron todos los factores categóricos en factores categóricos numéricos. De esta manera es posible la agrupación por parte de los algoritmos.
#Convert categorical dataset into numerical categorical
datosIneN <- datosIne
datosIneN$depocu <- as.numeric(factor(datosIne$depocu))
datosIneN$mupocu <- as.numeric(factor(datosIne$mupocu))
datosIneN$sexo <- as.numeric(factor(datosIne$sexo))
datosIneN$diaocu <- as.numeric(factor(datosIne$diaocu))
datosIneN$anoreg <- as.numeric(factor(datosIne$anoreg))
datosIneN$mesocu <- as.numeric(factor(datosIne$mesocu))
datosIneN$edadif <- as.numeric(factor(datosIne$edadif))
datosIneN$ecidif <- as.numeric(factor(datosIne$ecidif))
datosIneN$escodif <- as.numeric(factor(datosIne$escodif))
datosIneN$dredif <- as.numeric(factor(datosIne$dredif))
datosIneN$mredif <- as.numeric(factor(datosIne$mredif))
datosIneN$caudef <- as.numeric(factor(datosIne$caudef))A continuación se presentan las correlaciones que existen entre los diferentes datos:
library(corrplot)
matriz_cor <- cor(datosIneN[-12])
matriz_cor## depocu mupocu sexo diaocu anoreg
## depocu 1.000000000 0.205720208 -0.017256669 0.004702080 -0.030360964
## mupocu 0.205720208 1.000000000 -0.001957212 -0.006488912 -0.014574496
## sexo -0.017256669 -0.001957212 1.000000000 0.015149855 -0.012559761
## diaocu 0.004702080 -0.006488912 0.015149855 1.000000000 -0.010184627
## anoreg -0.030360964 -0.014574496 -0.012559761 -0.010184627 1.000000000
## mesocu -0.006529495 0.047564284 0.024227968 0.004367083 -0.002821199
## edadif 0.031438237 0.016980196 0.083899626 -0.015698844 -0.023512914
## ecidif 0.022607910 -0.026573307 0.011808755 0.009005604 0.017316036
## escodif 0.027410950 0.020503068 0.005634850 0.008957486 -0.044802338
## dredif 0.709138539 0.148679695 -0.035201147 0.009261684 -0.047643705
## mredif 0.020022482 0.430186448 -0.016120104 0.002163981 0.007913470
## mesocu edadif ecidif escodif dredif
## depocu -0.0065294950 0.031438237 0.0226079100 0.027410950 0.709138539
## mupocu 0.0475642844 0.016980196 -0.0265733072 0.020503068 0.148679695
## sexo 0.0242279677 0.083899626 0.0118087555 0.005634850 -0.035201147
## diaocu 0.0043670826 -0.015698844 0.0090056041 0.008957486 0.009261684
## anoreg -0.0028211987 -0.023512914 0.0173160359 -0.044802338 -0.047643705
## mesocu 1.0000000000 -0.008789969 0.0001362984 0.025936582 -0.018823654
## edadif -0.0087899685 1.000000000 -0.2354840210 0.218402044 0.029386973
## ecidif 0.0001362984 -0.235484021 1.0000000000 -0.096136139 -0.002995959
## escodif 0.0259365818 0.218402044 -0.0961361391 1.000000000 0.038782148
## dredif -0.0188236543 0.029386973 -0.0029959590 0.038782148 1.000000000
## mredif 0.0088977228 0.013753846 -0.0462778893 0.037447426 0.068552879
## mredif
## depocu 0.020022482
## mupocu 0.430186448
## sexo -0.016120104
## diaocu 0.002163981
## anoreg 0.007913470
## mesocu 0.008897723
## edadif 0.013753846
## ecidif -0.046277889
## escodif 0.037447426
## dredif 0.068552879
## mredif 1.000000000 corrplot(matriz_cor)
Como se puede observar, con excepción del departamento de registro de la defunción y el departamento de ocurrencia, las variables son independientes entre sí. Es evidente la razón de la existencia de la relación depocu y dredif, sin embargo es interesante observar como el valor de correlación no es uno. Lo que significa que existe un porcentaje considerable de decesos que se registran en departamentos diferentes.
Se realiza una gráfica de codo para determinar el número de grupos para la realización de los clústeres.
wss <- (nrow(datosIneN[-12])-1)*sum(apply(datosIneN[-12],2,var))
for (i in 2:10)
wss[i] <- sum(kmeans(datosIneN[-12], centers=i)$withinss)
plot(1:10, wss, type="b", xlab="Number of Clusters", ylab="Within groups sum of squares")
Dos es el número indicado.
Se inicia con un clúster con el algoritmo de Kmeans.
#Cluster Kmeans
library(cluster) #Para calcular la silueta
library(fpc)
km<-kmeans(datosIneN[-12],2)
plotcluster(datosIneN[-12],km$cluster)
#Método de la silueta para las k-medias
silkm<-silhouette(km$cluster,dist(datosIneN[-12]))
mean(silkm[,3]) #0.55, no es la mejor partición pero no está mal## [1] 0.4265287Kmodes es una variación del algoritmo especifica para variables categoricas, por lo que se realiza esperando un mejor valor de silueta.
#Cluster Kmodes
library(klaR)## Loading required package: MASS##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## selectkmo<-kmodes(datosIneN[-12], 2, iter.max = 10, weighted = FALSE)## Warning in kmodes(datosIneN[-12], 2, iter.max = 10, weighted = FALSE): data has
## numeric coloumns with more than 30 different levels!#kmo
plotcluster(datosIneN[-12],kmo$cluster)
#Método de la silueta para las k-medias
silkm<-silhouette(kmo$cluster,dist(datosIneN[-12]))
mean(silkm[,3]) #0.55, no es la mejor partición pero no está mal## [1] 0.000963793Al no mejorar se trabaja sobre Kmeans. Se grafican las variables para hacerse una idea de la manera en que están distribuidas respecto a las demás
plotp1 <- datosIneN[-12]
plotp2 <- plotp1[6:11]
plotp1 <- plotp1[1:6]
plot(plotp1)
plot(plotp2)
Se seleccionan mupocu, sexo, diaocu, mesocu, ecidif y dredif, gracias a que se optiene un mejor valor de silueta.
#datosIneN
dc <- datosIneN[c(2,3,4,6,8,10)]
km<-kmeans(dc,2)
plotcluster(dc,km$cluster)
silkm<-silhouette(km$cluster,dist(dc))
mean(silkm[,3]) ## [1] 0.616405Se prueba Cmeans para ver si mejora la silueta.
#datosIneN
library(e1071)
dc <- datosIneN[c(2,3,4,6,8,10)]
cm<-cmeans(dc,2)
plotcluster(dc,cm$cluster)
silkm<-silhouette(cm$cluster,dist(dc))
mean(silkm[,3]) ## [1] 0.6035969Se cuenta con mejor un mejor agrupamiento. Además se prueba con mixture of gaussians.
#datosIneN
library(mclust)## Package 'mclust' version 5.4.5
## Type 'citation("mclust")' for citing this R package in publications.dc <- datosIneN[c(3,5,6,11)]
mc<-Mclust(dc,2)
plot(mc, what = "classification", main="MClust Classification")
silmg<-silhouette(mc$classification,dist(dc))
mean(silmg[,3])## [1] 0.6644181Se prueba con clustering jerárquico.
#datosIneN
library(mclust)
dc <- datosIneN[c(3,5,6,11)]
hc<-hclust(dist(dc))
plot(hc)
rect.hclust(hc,k=2)
groups<-cutree(hc,k=2)
silch<-silhouette(groups,dist(dc))
mean(silch[,3])## [1] 0.6675357Por ser el mejor agrupamiento, este es el clúster seleccionado. A continuación se muestran los grupos formados.
datosIne$grupo <- groups
g1<-datosIne[datosIne$grupo==1,]
g2<-datosIne[datosIne$grupo==2,]Para el análisis de los clústeres se procedio a generar las tablas de frecuencia e histogramas de todas las varibles, como se muestra acontinuación:
df <- g1 %>%
group_by(depocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## depocu count n
## <chr> <int> <dbl>
## 1 Escuintla 1012 1
## 2 Guatemala 902 2
## 3 Quetzaltenango 725 3
## 4 Izabal 639 4
## 5 SantaRosa 555 5
## 6 Peten 538 6
## 7 Jutiapa 442 7
## 8 Huehuetenango 358 8
## 9 Retalhuleu 310 9
## 10 Quiche 251 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(depocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## depocu count n
## <chr> <int> <dbl>
## 1 Escuintla 406 1
## 2 Guatemala 318 2
## 3 Huehuetenango 206 3
## 4 Chimaltenango 178 4
## 5 Peten 164 5
## 6 Zacapa 143 6
## 7 SantaRosa 137 7
## 8 AltaVerapaz 136 8
## 9 SanMarcos 124 9
## 10 Quiche 122 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(mupocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## mupocu count n
## <chr> <int> <dbl>
## 1 Guatemala 643 1
## 2 Escuintla 551 2
## 3 Cuilapa 334 3
## 4 PuertoBarrios 293 4
## 5 Coatepeque 288 5
## 6 Quetzaltenango 276 6
## 7 Jutiapa 183 7
## 8 Morales 179 8
## 9 SanBenito 173 9
## 10 Retalhuleu 171 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(mupocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## mupocu count n
## <chr> <int> <dbl>
## 1 Guatemala 186 1
## 2 Escuintla 166 2
## 3 Zacapa 101 3
## 4 Tiquisate 82 4
## 5 Cuilapa 70 5
## 6 SantaCruzdelQuiche 68 6
## 7 Chimaltenango 60 7
## 8 Solola 54 8
## 9 SantaLuciaCotzumalguapa 52 9
## 10 Totonicapan 49 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(sexo) %>%
summarise(count = n())
df <- df[order(-df$count),]
print(df)## # A tibble: 2 x 2
## sexo count
## <chr> <int>
## 1 Hombre 6350
## 2 Mujer 1387ggplot(df, aes(x = reorder(sexo, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(sexo) %>%
summarise(count = n())
df <- df[order(-df$count),]
print(df)## # A tibble: 2 x 2
## sexo count
## <chr> <int>
## 1 Hombre 2207
## 2 Mujer 427ggplot(df, aes(x = reorder(sexo, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(diaocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## diaocu count n
## <chr> <int> <dbl>
## 1 1 324 1
## 2 15 300 2
## 3 25 291 3
## 4 2 288 4
## 5 5 278 5
## 6 4 274 6
## 7 3 271 7
## 8 16 269 8
## 9 22 268 9
## 10 17 264 10ggplot(df, aes(x = reorder(diaocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(diaocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## diaocu count n
## <chr> <int> <dbl>
## 1 9 120 1
## 2 11 103 2
## 3 1 102 3
## 4 21 101 4
## 5 26 99 5
## 6 29 98 6
## 7 17 97 7
## 8 25 94 8
## 9 22 92 9
## 10 3 92 10ggplot(df, aes(x = reorder(diaocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(anoreg) %>%
summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 9 x 3
## anoreg count n
## <chr> <int> <dbl>
## 1 2018 2298 1
## 2 2017 1151 2
## 3 2014 950 3
## 4 2015 911 4
## 5 2013 873 5
## 6 2011 719 6
## 7 2012 708 7
## 8 2019 106 8
## 9 2016 21 9ggplot(df, aes(x = reorder(anoreg, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(anoreg) %>%
summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 9 x 3
## anoreg count n
## <chr> <int> <dbl>
## 1 2018 863 1
## 2 2017 327 2
## 3 2015 316 3
## 4 2014 299 4
## 5 2013 298 5
## 6 2012 269 6
## 7 2011 225 7
## 8 2019 30 8
## 9 2016 7 9ggplot(df, aes(x = reorder(anoreg, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(mesocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## mesocu count n
## <chr> <int> <dbl>
## 1 Diciembre 859 1
## 2 Marzo 681 2
## 3 Noviembre 663 3
## 4 Enero 657 4
## 5 Septiembre 639 5
## 6 Julio 636 6
## 7 Junio 634 7
## 8 Abril 612 8
## 9 Febrero 610 9
## 10 Octubre 586 10ggplot(df, aes(x = reorder(mesocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(mesocu) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## mesocu count n
## <chr> <int> <dbl>
## 1 Diciembre 283 1
## 2 Marzo 270 2
## 3 Septiembre 253 3
## 4 Abril 229 4
## 5 Enero 214 5
## 6 Noviembre 208 6
## 7 Febrero 204 7
## 8 Mayo 202 8
## 9 Junio 200 9
## 10 Agosto 194 10ggplot(df, aes(x = reorder(mesocu, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(edadif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## edadif count n
## <chr> <int> <dbl>
## 1 21 244 1
## 2 24 234 2
## 3 20 233 3
## 4 25 226 4
## 5 23 225 5
## 6 22 224 6
## 7 28 222 7
## 8 26 215 8
## 9 19 213 9
## 10 27 201 10ggplot(df, aes(x = reorder(edadif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(edadif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## edadif count n
## <chr> <int> <dbl>
## 1 22 99 1
## 2 21 92 2
## 3 23 90 3
## 4 24 86 4
## 5 26 84 5
## 6 20 83 6
## 7 25 77 7
## 8 19 74 8
## 9 27 72 9
## 10 29 69 10ggplot(df, aes(x = reorder(edadif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(ecidif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 4 x 3
## ecidif count n
## <chr> <int> <dbl>
## 1 Soltero 5337 1
## 2 Casado 2250 2
## 3 Ignorado 87 3
## 4 Unido 63 4ggplot(df, aes(x = reorder(ecidif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(ecidif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 4 x 3
## ecidif count n
## <chr> <int> <dbl>
## 1 Soltero 1725 1
## 2 Casado 876 2
## 3 Unido 24 3
## 4 Ignorado 9 4ggplot(df, aes(x = reorder(ecidif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(escodif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 7 x 3
## escodif count n
## <chr> <int> <dbl>
## 1 Primaria 2335 1
## 2 Ninguna 2102 2
## 3 Diversificado 1281 3
## 4 Basico 1013 4
## 5 Ignorado 864 5
## 6 Universitario 141 6
## 7 Postgrado 1 7ggplot(df, aes(x = reorder(escodif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(escodif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 6 x 3
## escodif count n
## <chr> <int> <dbl>
## 1 Primaria 927 1
## 2 Ninguna 755 2
## 3 Diversificado 389 3
## 4 Basico 350 4
## 5 Ignorado 163 5
## 6 Universitario 50 6ggplot(df, aes(x = reorder(escodif, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(dredif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## dredif count n
## <chr> <int> <dbl>
## 1 Guatemala 890 1
## 2 Izabal 650 2
## 3 Escuintla 647 3
## 4 Ignorado 577 4
## 5 Quetzaltenango 537 5
## 6 Jutiapa 478 6
## 7 Peten 471 7
## 8 SantaRosa 443 8
## 9 Huehuetenango 337 9
## 10 SanMarcos 328 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(dredif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## dredif count n
## <chr> <int> <dbl>
## 1 Guatemala 366 1
## 2 Escuintla 300 2
## 3 Huehuetenango 212 3
## 4 Chimaltenango 183 4
## 5 AltaVerapaz 175 5
## 6 Peten 169 6
## 7 SanMarcos 161 7
## 8 Zacapa 151 8
## 9 Solola 149 9
## 10 Quiche 135 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g1 %>%
group_by(mredif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## mredif count n
## <chr> <int> <dbl>
## 1 Ignorado 577 1
## 2 Guatemala 539 2
## 3 Escuintla 224 3
## 4 PuertoBarrios 212 4
## 5 Morales 210 5
## 6 Mixco 154 6
## 7 Quetzaltenango 152 7
## 8 Jutiapa 142 8
## 9 NuevaConcepciin 132 9
## 10 Coatepeque 119 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
df <- g2 %>%
group_by(mredif) %>%
summarise(count = n())
df <- df[order(-df$count),]
df <- df[1:10,]
df$n <- 1
for (i in 1:nrow(df)){
df[i,]$n <- i
}
print(df)## # A tibble: 10 x 3
## mredif count n
## <chr> <int> <dbl>
## 1 VillaNueva 159 1
## 2 SantaLuciaCotzumalguapa 116 2
## 3 Zacapa 97 3
## 4 SanJose 81 4
## 5 VillaCanales 81 5
## 6 SanLuis 72 6
## 7 Sayaxche 71 7
## 8 SantaCruzdelQuiche 70 8
## 9 TecpanGuatemala 69 9
## 10 Tiquisate 66 10ggplot(df, aes(x = reorder(n, count), y = count)) + geom_bar(fill = "blue", stat = "identity") + geom_text(aes(label = count), vjust = -0.5) + theme_pubclean()
En primer lugar, podemos observar que el Grupo No.1 generado por el clúster es considerablemente más grande que el Grupo No. 2. En una proporción aproximada de 3 a 1. Para las variables sexo, año de ocurrencia, mes de ocurrencia, edad, estado civil y educación, parecería ser que el clúster dividió la frecuencia en proporciones iguales entre los grupos. Por lo que no brinda gran información para generar una diferenciación. Si ignoramos los valores de Guatemala y escuintla, gracias a que cuentan con una mayor frecuencia; pareciera ser que las variables de departamento de ocurrencia, municipio de ocurrencia , departamento de residencia del difunto y municipio de residencia del difunto, dividen el país en regiones diferentes. Por lo que esto puede ser una manera en que se diferencien los grupos. Nombrandolos Región 1 y Región 2. Además en lo que respecta a los días de ocurrencia, pareciera ser que se dividen los días del mes entre los dos grupos. El primer grupo contando con más días de la primera y segunda semana si no se toman en consideración los repetidos. Y el segundo grupo con más días de la tercera y última semana, sino se toman en cuenta los repetidos. Por lo que podría ser otra manera en que se le podría designar a los grupos, Mitad 1 del mes, Mitad 2 del mes.
Hallazgos INE
El objetivo al analizar la base de datos de defunciones del INE fue identificar aquellas muertes que sucedieron a causa de un accidente automovilístico y las condiciones en las que estos ocurrieron. A la vez, se buscó reconocer aquellos datos que se pudieran relacionar con los datos de importación de vehículos de la SAT. Uno de los datos con potencial para identificar estas características, fue la distribución de defunciones según el departamento, ya que se podría razonar que, en aquellos departamentos con mayor población y tráfico vehicular, es mucho más probable que existan defunciones por accidentes. La tasa de crecimiento de decesos por año había sido lineal, hasta que en 2018 mostró crecer de forma exponencial, lo cual se puede atribuir a un mejor registro, pero tiene el potencial de que sea por mayor circulación de vehículos, y como se puede observar en la base de datos de la SAT, la importación de vehículos ha crecido de forma exponencial también. Respecto a las características que aquellos que han fallecido en accidentes automovilísticos, han sido en su gran mayoría adultos jóvenes de alrededor de los 20 años. Esta característica se puede razonar, que es debido al estilo de vida que es común en esas edades, tal como falta de experiencia al conducir, y que conforme aumenta la edad, los decesos se reducen.
Al realizar un análisis de los datos con la gráfica de codo, se decidió que la cantidad ideal de clusters sería 2. Luego de esto se crearon los grupos utilizando los métodos de clustering kmeans, kmodes, cmeans y hclust, realizando la prueba de la silueta para cada resultado. Al realizar la prueba de la silueta se encontró que el método con el mejor resultado fue hclust, por lo cual se utilizará la agrupación creada por este.
Hallazgos SAT
Nuestro objetivo al realizar en análisis de datos sobre la base de datos de importaciones de la SAT era poder identificar tendencias en las características de los vehículos importados. Al analizar esta información se buscará alguna relación existente entre estas características con aquellas identificadas en la base de datos del INE. La relación que se espera encontrar es que aquellos vehículos que están involucrados en mayor cantidad de accidentes de tránsito que resulte en la muerte de las personas, también posean alguna característica evidente en la base de datos de importaciones. Por el momento lo que se han logrado identificar algunas características de los vehículos importados que podrían aportar a los fines de la investigación. Se encontró que el tipo de vehículo que más se importa en Guatemala es la motocicleta, lo cual podría tener alta significancia en el ámbito de defunciones por accidentes automovilísticos, ya que se le suele atribuir a las motocicletas como un medio de transporte más peligroso que otros. Este dato también viene respaldado por las otras variables que también resultaron teniendo las características de una motocicleta como la más común, por ejemplo, el tamaño del motor, la cantidad de asientos, el número de puertas y el peso del vehículo.
Al realizar un análisis con la gráfica de codo, se encontró que la cantidad ideal de clusters a crear serían 2, y se crearon clusters con varios métodos diferentes para identificar cual de todos tenía un mejor resultado en la prueba de la silueta, y se encontró que el mejor método fue kmeans. Se analizaron los 2 grupos creados por kmeans, evaluando las características de cada variable según el grupo al que pertenecían.
Conclusión
En lo que respecta al siguiente paso a seguir, se considera que en base a los hallazgos es posible generar un modelo que auxilie en la determinación de riesgos de accidentes fatales en regiones las condiciones temporales.